home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
rlib.zip
/
DEMO.PRG
< prev
next >
Wrap
Text File
|
1993-01-04
|
33KB
|
898 lines
* Program.: DEMO.PRG
* Author..: Richard Low
* Date....: October 6, 1988
* Notes...: Program to demonstrate the RLIB functions.
*
PARAMETER edit
*-- the command line argument "EDIT" will allow mods to memo fields
*-- (I used this flag to build the descriptions )
edit = IF( PCOUNT() = 1, ( UPPER(edit) = 'EDIT' ), .F. )
IF .NOT. FILES('demo.dbf', 'demo.dbt')
? 'This demo requires the database file DEMO.DBF and its associated memo'
? 'file DEMO.DBT which are included in the RLIB package. Please place'
? 'these two files in the current default directory and try again.'
? CHR(7)
RETURN
ENDIF
SET PROCEDURE TO demoproc
SAVE SCREEN TO dosscreen
saverow = ROW()
savecol = COL()
SET COLOR TO W/N
CLEAR
@ 3,0
TEXT
Welcome to the RLIB demonstration program. The purpose of this demo is to
show what RLIB functions can do. It can also serve as a supplement to the
documentation by providing examples of RLIB functions in use.
The demo starts by presenting you with a menu of RLIB function categories.
Each of these categories presents a sub - menu with the available choices.
The starting menu is a BOXMENU, but you may change the style of menus used
for the demonstration at any time. Simply select from the Menuing Tools
menu the style of menu you want, and the demo will continue, but under the
style of menu you have chosen.
ENDTEXT
@ 1,0,18,79 BOX '┌─┐│┘─└│'
*-- first need to initialize all public variables and arrays
DO initialize
CENTER( 16, 'Press any key to begin...' )
x = INKEY(30)
DO WHILE x = 0
x = ASC(BOXASK('N/W','The demo will start as soon as you press a key',4))
x = IF( x = 0, INKEY(10), x )
ENDDO
CLEAR
IF LASTKEY() = 27
RETURN
ENDIF
SET CURSOR OFF
*-- Each active menu routine may control the whole demo. If the user
*-- selectes a different menu control, the current routine will set
*-- <menustyle> accordingly and exit back to this main loop. The
*-- Summer '87 BEGIN SEQUENCE facility is used to allow conditional
*-- branching back to this main routine from within the other procs.
PUBLIC menustyle, showtime, dummy, single, double
menustyle = 2 && start off with BOXMENU
showtime = 2 && seconds to pause while showing syntax
dummy = '' && global DUMMY parameter
single = '┌─┐│┘─└│' && used for single line boxes
double = '╔═╗║╝═╚║' && used for double line boxes
*-- open the demo database so quickley retrieve syntax descriptions
USE demo INDEX demo
*-- each routine will set menustyle to 0 to quit
DO WHILE menustyle > 0
BEGIN SEQUENCE
DO CASE
CASE menustyle = 1
DO bardemo
CASE menustyle = 2
DO boxdemo
CASE menustyle = 3
DO multdemo
CASE menustyle = 4
DO pulldemo
ENDCASE
END
ENDDO
RESTORE SCREEN FROM dosscreen
@ saverow,savecol SAY ''
CLOSE DATABASES
SET CURSOR ON
SET COLOR TO
CLEAR ALL
RETURN
*-- End of main program.
*----------------------------------------------------------------------------
* Procedure: INITIALIZE
* Notes....: Procedure to initialize demo procedure names into a PUBLIC
* array to be later referenced via the DIM2() UDF.
* These demo procedures are called via macro substitution at
* run time by first retrieving the name of the demo procedure
* to run from the combination of menu options chosen. These
* options pair correspond to the DIM2 location of the procedure
* name in the <demos> array, which, thanks to the DIM@() UDF,
* looks and acts like a two dimensional array.
*----------------------------------------------------------------------------
PROCEDURE initialize
*-- set color variables and arrays for the demo
PUBLIC democolor, syntaxcolor, background
IF ISCOLOR()
PUBLIC boxcolors[5], barcolors[5], pullcolors[6], multicolors[5]
democolor = 'W/B,N/W,N,N,N/BG'
syntaxcolor = 'N/BG,W/B,N,N,N/B'
background = 'W/N,N/W,N,N,N/W'
boxcolors[1] = 'W/B' && White on Blue display
boxcolors[2] = 'N/BG' && Black on Cyan menu bar
boxcolors[3] = 'BG+/B' && Bright Cyan on Blue Active Border
boxcolors[4] = 'BG/B' && Regular Cyan on Blue In-active Border
boxcolors[5] = 'GR+/B' && Yellow on Blue for the selected option
barcolors[1] = 'W/B' && White on Blue display
barcolors[2] = 'N/BG' && Black on Cyan menu bar
barcolors[3] = 'BG+/B' && Bright Cyan on Blue Active Border
barcolors[4] = 'BG/B' && Regular Cyan on Blue In-active Border
barcolors[5] = 'GR+/B' && Yellow on Blue for the selected option
pullcolors[1] = 'W/B' && White on Blue display
pullcolors[2] = 'N/BG' && Black on Cyan menu bar
pullcolors[3] = 'BG+/B' && Bright Cyan on Blue Active Border
pullcolors[4] = 'BG/B' && Regular Cyan on Blue In-active Border
pullcolors[5] = 'GR+/B' && Yellow on Blue for the selected option
pullcolors[6] = 'GR+/B'
multicolors[1] = 'W/B' && White on Blue display
multicolors[2] = 'N/BG' && Black on Cyan menu bar
multicolors[3] = 'BG+/B' && Bright Cyan on Blue Active Border
multicolors[4] = 'BG/B' && Regular Cyan on Blue In-active Border
multicolors[5] = 'GR+/B' && Yellow on Blue for the selected option
ELSE
PUBLIC boxcolors, barcolors, pullcolors
democolor = 'W/N,N/W,N,N,U'
syntaxcolor = 'N/W,W/N,N,N,U'
background = 'W/N,N/W,N,N,U'
STORE '' TO boxcolors, barcolors, pullcolors
PUBLIC multicolors[5]
multicolors[1] = 'W/N' && White on Black display
multicolors[2] = 'N/W' && Black on White menu bar
multicolors[3] = ' '
multicolors[4] = ' '
multicolors[5] = 'W+/N' && Bright White for selected option
ENDIF
PUBLIC rows, cols && this is required by the DIM2() UDF
rows = 6 && six groups of functions
cols = 7 && maximum number in each group
PUBLIC demos[ rows * cols ]
demos[ DIM2(1,1) ] = 'd'
demos[ DIM2(1,2) ] = 'd'
demos[ DIM2(1,3) ] = 'd'
demos[ DIM2(1,4) ] = 'd'
demos[ DIM2(2,1) ] = 'd_atinsay' && Screen functions
demos[ DIM2(2,2) ] = 'd_boxask'
demos[ DIM2(2,3) ] = 'd_bright'
demos[ DIM2(2,4) ] = 'd_center'
demos[ DIM2(2,5) ] = 'd_multimenu'
demos[ DIM2(2,6) ] = 'd_sayinbox'
demos[ DIM2(3,1) ] = 'd_filedate' && File functions
demos[ DIM2(3,2) ] = 'd_files'
demos[ DIM2(3,3) ] = 'd_filetime'
demos[ DIM2(3,4) ] = 'd_parent'
demos[ DIM2(3,5) ] = 'd_pathto'
demos[ DIM2(3,6) ] = 'd_pickfile'
demos[ DIM2(4,1) ] = 'd_decrypted' && Character
demos[ DIM2(4,2) ] = 'd_encrypted'
demos[ DIM2(4,3) ] = 'd_getparm'
demos[ DIM2(4,4) ] = 'd_keyinput'
demos[ DIM2(4,5) ] = 'd_namesplit'
demos[ DIM2(4,6) ] = 'd_rjustify'
demos[ DIM2(5,1) ] = 'd_changed' && Database
demos[ DIM2(5,2) ] = 'd_closearea'
demos[ DIM2(5,3) ] = 'd_forget'
demos[ DIM2(5,4) ] = 'd_markrec'
demos[ DIM2(5,5) ] = 'd_memorize'
demos[ DIM2(5,6) ] = 'd_mreplace'
demos[ DIM2(5,7) ] = 'd_pickrec'
demos[ DIM2(6,1) ] = 'd_alphadate' && Other
demos[ DIM2(6,2) ] = 'd_beep'
demos[ DIM2(6,3) ] = 'd_ntxkeyval'
demos[ DIM2(6,4) ] = 'd_str2date'
USE demo
INDEX ON udf_name TO demo
USE
RETURN
*----------------------------------------------------------------------------
* Function: DIM2
* Notes...: UDF to emulate 2 dimensional arrays.
*----------------------------------------------------------------------------
FUNCTION dim2
PARAMETERS x,y
RETURN (((x - 1) * cols) + y)
*----------------------------------------------------------------------------
* Procedure: BOXDEMO
* Notes....: Sub procedure to control demo with BOXMENU(), default.
* Assumes..: Nothing.
*----------------------------------------------------------------------------
PROCEDURE BoxDemo
*-- set up arrays to hold menu options and messages
DECLARE option[7], message[7]
*-- they don't have to be the same length, just a matter of preference
option[1] = ' 1. Menuing Tools '
option[2] = ' 2. Screen Utilities '
option[3] = ' 3. File Functions '
option[4] = ' 4. Character Handling '
option[5] = ' 5. Database Functions '
option[6] = ' 6. Other Functions '
option[7] = ' 7. Quit to DOS '
message[1] = 'Menus never were easier and more powerful!'
message[2] = 'Helpful goodies for prompting and error messages'
message[3] = 'Find files, get file dates and times, and other stuff'
message[4] = 'Handy character string functions, all in Clipper!'
message[5] = 'Make editing database files easy'
message[6] = "A few UDF's to use either now and then, or all the time"
message[7] = 'Before you quit, try all the neat menus'
*-- 1234567 will automatically select the choice, add 'MDFSDOQ'
altkeys = 'MSFCDOQ'
topchoice = 1
toprow = 3
topcol = CENTER(option[1]) && put BOXMENU in center of screen
promptrow = 24 && menu prompts on bottom line
CLEAR
DO WHILE .T.
topchoice = BOXMENU( toprow, topcol, option, topchoice, altkeys,;
dummy, message, promptrow, boxcolors )
DO CASE
CASE topchoice = 0
topchoice = 7
CASE topchoice = 7
menustyle = 0 && force calling proc to terminate
BREAK
OTHERWISE
*-- make the sub-menu one row below the selected option
nextrow = toprow + topchoice + 1
DO SubBoxMenu WITH topchoice, nextrow
ENDCASE
ENDDO
RETURN
*----------------------------------------------------------------------------
* Procedure: SubBoxMenu
* Notes....: Sub procedure to control demo with BOXMENU(), default.
* Assumes..: Nothing.
*----------------------------------------------------------------------------
PROCEDURE SubBoxMenu
PARAMETER group, row
PRIVATE choice, col, brow, bcol, window
DO CASE
CASE group = 1 && Menu
DECLARE rlib[3], mess[3]
rlib[1] = ' 1. BARMENU() '
rlib[2] = ' 2. MULTIMENU() '
rlib[3] = ' 3. PDOWNMENU() '
mess[1] = 'Change style of menus used for this demo to Bar Menu style'
mess[2] = 'Demonstration of the multi column menuing function'
mess[3] = 'Change style of menus used for this demo to Pull Down Menu style'
CASE group = 2 && Screen
DECLARE rlib[6], mess[6]
rlib[1] = ' 1. ATINSAY() '
rlib[2] = ' 2. BOXASK() '
rlib[3] = ' 3. BRIGHT() '
rlib[4] = ' 4. CENTER() '
rlib[5] = ' 5. MULTIMENU() '
rlib[6] = ' 6. SAYINBOX() '
mess[1] = 'Display a string at a given screen coordinate in color provided'
mess[2] = 'Pop-up dialogue box in screen center to get user response'
mess[3] = 'Get the bright version of the current, or provided screen color'
mess[4] = 'Calculate column position to center a string, with optional display'
mess[5] = 'Another demonstration of the MULTIMENU function. Try it!'
mess[6] = 'Easily display messages in screen centered pop-up boxes'
CASE group = 3 && File
DECLARE rlib[6], mess[6]
rlib[1] = ' 1. FILEDATE() '
rlib[2] = ' 2. FILES() '
rlib[3] = ' 3. FILETIME() '
rlib[4] = ' 4. PARENT() '
rlib[5] = ' 5. PATHTO() '
rlib[6] = ' 6. PICKFILE() '
mess[1] = 'Get the last update date for a file'
mess[2] = 'Test for existance of multiple files at one time'
mess[3] = 'Get the last update time for a file'
mess[4] = 'Get the parent directory name for the current or indicated directory'
mess[5] = 'Search the DOS path for the path leading to the indicated file'
mess[6] = 'Pop-up a file directory listing from which to select a filename'
CASE group = 4 && Character
DECLARE rlib[6], mess[6]
rlib[1] = ' 1. DECRYPTED() '
rlib[2] = ' 2. ENCRYPTED() '
rlib[3] = ' 3. GETPARM() '
rlib[4] = ' 4. KEYINPUT() '
rlib[5] = ' 5. NAMESPLIT() '
rlib[6] = ' 6. RJUSTIFY() '
mess[1] = 'Decrypt a character string encrypted with ENCRYPT()'
mess[2] = 'Encrypt a character string to make it un-readable'
mess[3] = 'Retrieve a comma delimited parameter from a character string'
mess[4] = 'Get keyboard input while echoing dots on screen'
mess[5] = 'Convert names in a Firstname Lastname format to Lastname first'
mess[6] = 'Right justify character strings by moving trailing blanks to the front'
CASE group = 5 && Database
DECLARE rlib[7], mess[7]
rlib[1] = ' 1. CHANGED() '
rlib[2] = ' 2. CLOSEAREA() '
rlib[3] = ' 3. FORGET() '
rlib[4] = ' 4. MARKREC() '
rlib[5] = ' 5. MEMORIZE() '
rlib[6] = ' 6. MREPLACE() '
rlib[7] = ' 7. PICKREC() '
mess[1] = 'Check if any changes made to database fields being edited'
mess[2] = 'Close more that one database file at a time'
mess[3] = 'Release edit variables created with the MEMORIZE() function'
mess[4] = 'Select multiple database records for processing'
mess[5] = 'Save all fields to variables for editing'
mess[6] = 'Replace database fields with edited field variables created with MEMORIZE()'
mess[7] = 'Versatile method of selecting a database record to work with'
CASE group = 6 && Other
DECLARE rlib[4], mess[4]
rlib[1] = ' 1. ALPHADATE() '
rlib[2] = ' 2. BEEP() '
rlib[3] = ' 3. NTXKEYVAL() '
rlib[4] = ' 4. STR2DATE() '
mess[1] = 'Easily print the supplied date in spelled out format'
mess[2] = 'Ring the system bell any specified number of times'
mess[3] = 'Get the index key value of the current record'
mess[4] = 'Convert date strings to date type variables'
ENDCASE
choice = 1 && start at first option
col = CENTER(rlib[1]) && center in middle of screen
brow = row + LEN(rlib) + 1 && calculate bottom row
bcol = col + LEN(rlib[1]) + 1 && calculate bottom right col
window = SAVESCREEN(row, col, brow, bcol) && save screen underneath
DO WHILE choice > 0 && BOXMENU returns 0 on Escape
choice = BOXMENU( row, col, rlib, choice, dummy, dummy,;
mess, promptrow, boxcolors )
IF choice = 0
*-- if Escape pressed, exit to top menu
EXIT
ELSEIF group = 1
*-- if in the Menu group, calculate menustyle number
menustyle = IF( choice = 1, 1, choice + 1 )
*-- must retore screen here as the BREAK bypasses the one below
RESTSCREEN(row, col, brow, bcol, window )
BREAK
ENDIF
*-- otherwise, get the demo procedure name from the DIM2() array
*-- based on the GROUP, CHOICE combination.
demoproc = demos[ DIM2(group,choice) ]
SAVE SCREEN
SET COLOR TO (democolor)
DO ShowSyntax
DO &demoproc
SET COLOR TO
RESTORE SCREEN
ENDDO
RESTSCREEN(row, col, brow, bcol, window ) && restore screen underneath
RETURN
*----------------------------------------------------------------------------
* Procedure: BARDEMO
* Notes....: Sub procedure to control demo with BARMENU(), default.
* Assumes..: Nothing.
*----------------------------------------------------------------------------
PROCEDURE BarDemo
*-- set up arrays to hold menu options and messages
DECLARE option[7], message[7]
*-- they don't have to be the same length, just a matter of preference
option[1] = 'Menu '
option[2] = 'Screen '
option[3] = 'File '
option[4] = 'Character '
option[5] = 'Database '
option[6] = 'Other '
option[7] = 'Quit '
message[1] = 'Box Menus, Multi-Column Menus, and Pull Down menus'
message[2] = 'Screen goodies for prompts and error messages'
message[3] = 'Find files, get file dates and times, and other stuff'
message[4] = 'Handy character string functions, all in Clipper!'
message[5] = 'Make editing database files easy'
message[6] = "A few UDF's to use either now and then, or all the time"
message[7] = 'Before you quit, try all the neat menus'
toprow = 1
promptrow = 2
topchoice = 1
CLEAR
DO WHILE .T.
topchoice = BARMENU( toprow, option, dummy, topchoice, dummy,;
dummy, message, promptrow, barcolors )
DO CASE
CASE topchoice = 0
topchoice = 7
CASE topchoice = 7
menustyle = 0 && force calling proc to terminate
BREAK
OTHERWISE
*-- make the sub-menu one row below the selected option
nextrow = toprow + topchoice + 1
DO SubBarMenu WITH topchoice
ENDCASE
ENDDO
RETURN
*----------------------------------------------------------------------------
* Procedure: SubBarMenu
* Notes....: Sub procedure to control demo with BARMENU().
* Assumes..: Nothing.
*----------------------------------------------------------------------------
PROCEDURE SubBarMenu
PARAMETER group
PRIVATE choice
DO CASE
CASE group = 1 && Menu
DECLARE rlib[3], mess[3]
rlib[1] = 'BOXMENU()'
rlib[2] = 'MULTIMENU()'
rlib[3] = 'PDOWNMENU()'
mess[1] = 'Change style of menus used for this demo to Bar Menu style'
mess[2] = 'Demonstration of the multi column menuing function'
mess[3] = 'Change style of menus used for this demo to Pull Down Menu style'
CASE group = 2 && Screen
DECLARE rlib[6], mess[6]
rlib[1] = 'ATINSAY()'
rlib[2] = 'BOXASK()'
rlib[3] = 'BRIGHT()'
rlib[4] = 'CENTER()'
rlib[5] = 'MULTIMENU()'
rlib[6] = 'SAYINBOX()'
mess[1] = 'Display a string at a given screen coordinate in color provided'
mess[2] = 'Pop-up dialogue box in screen center to get user response'
mess[3] = 'Get the bright version of the current, or provided screen color'
mess[4] = 'Calculate column position to center a string, with optional display'
mess[5] = 'Another demonstration of the MULTIMENU function. Try it!'
mess[6] = 'Easily display messages in screen centered pop-up boxes'
CASE group = 3 && File
DECLARE rlib[6], mess[6]
rlib[1] = 'FILEDATE()'
rlib[2] = 'FILES()'
rlib[3] = 'FILETIME()'
rlib[4] = 'PARENT()'
rlib[5] = 'PATHTO()'
rlib[6] = 'PICKFILE()'
mess[1] = 'Get the last update date for a file'
mess[2] = 'Test for existance of multiple files at one time'
mess[3] = 'Get the last update time for a file'
mess[4] = 'Get the parent directory name for the current or indicated directory'
mess[5] = 'Search the DOS path for the path leading to the indicated file'
mess[6] = 'Pop-up a file directory listing from which to select a filename'
CASE group = 4 && Character
DECLARE rlib[6], mess[6]
rlib[1] = 'DECRYPTED()'
rlib[2] = 'ENCRYPTED()'
rlib[3] = 'GETPARM()'
rlib[4] = 'KEYINPUT()'
rlib[5] = 'NAMESPLIT()'
rlib[6] = 'RJUSTIFY()'
mess[1] = 'Decrypt a character string encrypted with ENCRYPT()'
mess[2] = 'Encrypt a character string to make it un-readable'
mess[3] = 'Retrieve a comma delimited parameter from a character string'
mess[4] = 'Get keyboard input while echoing dots on screen'
mess[5] = 'Convert names in a Firstname Lastname format to Lastname first'
mess[6] = 'Right justify character strings by moving trailing blanks to the front'
CASE group = 5 && Database
DECLARE rlib[7], mess[7]
rlib[1] = 'CHANGED()'
rlib[2] = 'CLOSEAREA()'
rlib[3] = 'FORGET()'
rlib[4] = 'MARKREC()'
rlib[5] = 'MEMORIZE()'
rlib[6] = 'MREPLACE()'
rlib[7] = 'PICKREC()'
mess[1] = 'Check if memory field variables changed from data on disk'
mess[2] = 'Close multiple database files with one command'
mess[3] = 'Release public memory variables created with MEMORIZE()'
mess[4] = 'Select multiple records to work with from a database'
mess[5] = 'Copy database fields to memory variables fro editing'
mess[6] = 'Save field memory variables back to a database record'
mess[7] = 'Select a record to work with from a menu of records'
CASE group = 6 && Other
DECLARE rlib[4], mess[4]
rlib[1] = 'ALPHADATE()'
rlib[2] = 'BEEP()'
rlib[3] = 'NTXKEYVAL()'
rlib[4] = 'STR2DATE()'
mess[1] = 'Easily print the supplied date in spelled out format'
mess[2] = 'Ring the system bell any specified number of times'
mess[3] = 'Get the index key value of the current record'
mess[4] = 'Convert date strings to date type variables'
ENDCASE
choice = 1 && start at first option
DO WHILE choice > 0 && BOXMENU returns 0 on Escape
choice = BARMENU( toprow, rlib, dummy, choice, dummy, dummy,;
mess, promptrow, barcolors )
IF choice = 0
*-- if Escape pressed, exit to top menu
EXIT
ELSEIF group = 1
*-- if in the Menu group, calculate menustyle number
menustyle = choice + 1
BREAK
ENDIF
*-- otherwise, get the demo procedure name from the DIM2() array
*-- based on the GROUP,CHOICE combination.
demoproc = demos[ DIM2(group,choice) ]
SAVE SCREEN
SET COLOR TO (democolor)
DO ShowSyntax
DO &demoproc
SET COLOR TO
RESTORE SCREEN
ENDDO
RETURN
*----------------------------------------------------------------------------
* Procedure: MULTDEMO
* Notes....: Sub procedure to control demo with MULTIMENU()
* Assumes..: Nothing.
*----------------------------------------------------------------------------
PROCEDURE MultDemo
PRIVATE choice, colums, incolor, nameof_udf
*-- set up arrays to hold options and messages
DECLARE items[32], mess[32]
items[ 1] = ' ALPHADATE() '
items[ 2] = ' ATINSAY() '
items[ 3] = ' BARMENU() '
items[ 4] = ' BEEP() '
items[ 5] = ' BOXASK() '
items[ 6] = ' BOXMENU() '
items[ 7] = ' BRIGHT() '
items[ 8] = ' CENTER() '
items[ 9] = ' CHANGED() '
items[10] = ' CLOSEAREA() '
items[11] = ' DECRYPTED() '
items[12] = ' ENCRYPTED() '
items[13] = ' FILEDATE() '
items[14] = ' FILES() '
items[15] = ' FILETIME() '
items[16] = ' FORGET() '
items[17] = ' GETPARM() '
items[18] = ' KEYINPUT() '
items[19] = ' MARKREC() '
items[20] = ' MEMORIZE() '
items[21] = ' MREPLACE() '
items[22] = ' MULTIMENU() '
items[23] = ' NAMESPLIT() '
items[24] = ' NTXKEYVAL() '
items[25] = ' PARENT() '
items[26] = ' PATHTO() '
items[27] = ' PDOWNMENU() '
items[28] = ' PICKFILE() '
items[29] = ' PICKREC() '
items[30] = ' RJUSTIFY() '
items[31] = ' SAYINBOX() '
items[32] = ' STR2DATE() '
mess[ 1] = 'Easily print a date in spelled out format'
mess[ 2] = 'Display a string at a given screen coordinate in color provided'
mess[ 3] = 'Change style of menus used for this demo to Bar Menu style'
mess[ 4] = 'Ring the system bell any specified number of times'
mess[ 5] = 'Pop-up dialogue box in screen center to get user response'
mess[ 6] = 'Change style of menus used for this demo to Box Menu style'
mess[ 7] = 'Get the bright version of the current, or provided screen color'
mess[ 8] = 'Calculate column position to center a string, with optional display'
mess[ 9] = 'Check if any changes made to database fields being edited'
mess[10] = 'Close more that one database file at a time'
mess[11] = 'Decrypt a character string encrypted with ENCRYPT()'
mess[12] = 'Encrypt a character string to make it un-readable'
mess[13] = 'Get the last update date for a file'
mess[14] = 'Test for existance of multiple files at one time'
mess[15] = 'Get the last update time for a file'
mess[16] = 'Release edit variables created with the MEMORIZE() function'
mess[17] = 'Retrieve a comma delimited parameter from a character string'
mess[18] = 'Get keyboard input while echoing dots on screen'
mess[19] = 'Select multiple database records for processing'
mess[20] = 'Save all fields to variables for editing'
mess[21] = 'Replace database fields with edited field variables created with MEMORIZE()'
mess[22] = 'Another demonstration of the MULTIMENU function. Try it!'
mess[23] = 'Convert names in a Firstname Lastname format to Lastname first'
mess[24] = 'Get the index key value of the current record'
mess[25] = 'Get the parent directory name for the current or indicated directory'
mess[26] = 'Search the DOS path for the path leading to the indicated file'
mess[27] = 'Change style of menus used for this demo to Pull Down Menu style'
mess[28] = 'Pop-up a file directory listing from which to select a filename'
mess[29] = 'Versatile method of selecting a database record to work with'
mess[30] = 'Right justify character strings by moving trailing blanks to the front'
mess[31] = 'Easily display messages in screen centered pop-up boxes'
mess[32] = 'Convert date strings to date type variables'
CLEAR
arrows = CHR(24) + CHR(25) + CHR(27) + CHR(26)
columns = 6
incolor = SETCOLOR(multicolors[1])
SCROLL(16,0,22,79,0)
@ 16,0,22,79 BOX single
@ 17,4 SAY 'MULTIMENU() lets you select menu options by cursoring up, down, left, or'
@ 18,4 SAY 'right, without having to wade through levels of menus. From this menu'
@ 19,4 SAY 'you can directly select any of the RLIB demonstration routines, or you'
@ 20,4 SAY 'change the style of menus by selecting either BOXMENU(), BARMENU() or,'
@ 21,4 SAY 'PDOWNMENU(). Just pick the option you desire by pressing the &arrows keys.'
@ 1,0,9,79 BOX double
DO WHILE .T.
choice = MULTIMENU( 2,1,8,78, items, columns, mess, 24, multicolors )
SETCOLOR(incolor)
DO CASE
CASE choice = 0
*-- Escape, go back to default, BOXMENU style
menustyle = 2
BREAK
CASE choice = 3 && BARMENU
menustyle = 1
BREAK
CASE choice = 6 && BOXMENU
menustyle = 2
BREAK
CASE choice = 27 && PDOWNMENU
menustyle = 4
BREAK
OTHERWISE
*-- otherwise, get the demo procedure name from the DIM2() array
*-- based on the GROUP,CHOICE combination.
*-- the name of the procedure to call is the name of this function
*-- minus the trailing "()", with "d_" added to the front
nameof_udf = LTRIM(SUBSTR(items[choice], 1, AT("(",items[choice])-1))
demoproc = 'd_' + nameof_udf
SAVE SCREEN
SET COLOR TO (democolor)
DO ShowSyntax
DO &demoproc
SET COLOR TO
RESTORE SCREEN
ENDCASE
ENDDO
RETURN
*----------------------------------------------------------------------------
* Procedure: PULLDEMO
* Notes....: Sub procedure to control demo with PDOWNMENU()
* Assumes..: Nothing.
*
*----------------------------------------------------------------------------
PROCEDURE PullDemo
DECLARE menus[7], column[7], starts[7]
menus[1] = ' Menu '
menus[2] = ' Screen '
menus[3] = ' File '
menus[4] = ' Character '
menus[5] = ' Database '
menus[6] = ' Other '
menus[7] = ' Quit '
column[1] = 0
column[2] = 10
column[3] = 23
column[4] = 34
column[5] = 49
column[6] = 63
column[7] = 74
*-- set up arrays to hold menu options and messages
DECLARE item[34], mess[34]
starts[1] = 1
item[1] = ' BARMENU() '
item[2] = ' BOXMENU() '
item[3] = ' MULTIMENU() '
mess[1] = 'Change style of menus used for this demo to Bar Menu style'
mess[2] = 'Change style of menus used for this demo to Box Menu style'
mess[3] = 'Change style of menus used for this demo to Multi-column Menu style'
starts[2] = 4
item[4] = ' ATINSAY() '
item[5] = ' BOXASK() '
item[6] = ' BRIGHT() '
item[7] = ' CENTER() '
item[8] = ' MULTIMENU() '
item[9] = ' SAYINBOX() '
mess[4] = 'Display a string at a given screen coordinate in color provided'
mess[5] = 'Pop-up dialogue box in screen center to get user response'
mess[6] = 'Get the bright version of the current, or provided screen color'
mess[7] = 'Calculate column position to center a string, with optional display'
mess[8] = 'Another demonstration of the MULTIMENU function. Try it!'
mess[9] = 'Easily display messages in screen centered pop-up boxes'
starts[3] = 10
item[10] = ' FILEDATE() '
item[11] = ' FILES() '
item[12] = ' FILETIME() '
item[13] = ' PARENT() '
item[14] = ' PATHTO() '
item[15] = ' PICKFILE() '
mess[10] = 'Get the last update date for a file'
mess[11] = 'Test for existance of multiple files at one time'
mess[12] = 'Get the last update time for a file'
mess[13] = 'Get the parent directory name for the current or indicated directory'
mess[14] = 'Search the DOS path for the path leading to the indicated file'
mess[15] = 'Pop-up a file directory listing from which to select a filename'
starts[4] = 16
item[16] = ' DECRYPTED() '
item[17] = ' ENCRYPTED() '
item[18] = ' GETPARM() '
item[19] = ' KEYINPUT() '
item[20] = ' NAMESPLIT() '
item[21] = ' RJUSTIFY() '
mess[16] = 'Decrypt a character string encrypted with ENCRYPT()'
mess[17] = 'Encrypt a character string to make it un-readable'
mess[18] = 'Retrieve a comma delimited parameter from a character string'
mess[19] = 'Get keyboard input while echoing dots on screen'
mess[20] = 'Convert names in a Firstname Lastname format to Lastname first'
mess[21] = 'Right justify character strings by moving trailing blanks to the front'
starts[5] = 22
item[22] = ' CHANGED() '
item[23] = ' CLOSEAREA() '
item[24] = ' FORGET() '
item[25] = ' MARKREC() '
item[26] = ' MEMORIZE() '
item[27] = ' MREPLACE() '
item[28] = ' PICKREC() '
mess[22] = 'Check if any changes made to database fields being edited'
mess[23] = 'Close more that one database file at a time'
mess[24] = 'Release edit variables created with the MEMORIZE() function'
mess[25] = 'Select multiple database records for processing'
mess[26] = 'Save all fields to variables for editing'
mess[27] = 'Replace database fields with edited field variables created with MEMORIZE()'
mess[28] = 'Versatile method of selecting a database record to work with'
starts[6] = 29
item[29] = ' ALPHADATE() '
item[30] = ' BEEP() '
item[31] = ' NTXKEYVAL() '
item[32] = ' STR2DATE() '
mess[29] = 'Easily print a date in spelled out format'
mess[30] = 'Ring the system bell any specified number of times'
mess[31] = 'Get the index key value of the current record'
mess[32] = 'Convert date strings to date type variables'
starts[7] = 33
item[33] = 'No '
item[34] = 'Yes '
mess[33] = 'Do not quit just yet, return to demostration'
mess[34] = 'Quit and return to DOS'
*-- start with menu number one, no drop down
menu = 1
choice = 0
mrow = 1
prow = 24
*-- clear the screen, or just make sure it is the way you want it
*-- to appear underneath the pull-down menu boxes
CLEAR
PDOWNINIT( mrow, column, menus, item, starts, mess, prow, pullcolors )
DO WHILE .T.
PDOWNMENU( @menu, @choice, menus, item, column, starts, mess )
DO CASE
CASE menu = 0
CASE menu = 1
menustyle = choice
BREAK
CASE menu = 7
IF choice = 2
menustyle = 0
BREAK
ENDIF
OTHERWISE
*-- otherwise, get the demo procedure name from the DIM2() array
*-- based on the GROUP,CHOICE combination.
demoproc = demos[ DIM2( menu, choice ) ]
SAVE SCREEN
SET COLOR TO (democolor)
DO ShowSyntax
DO &demoproc
SET COLOR TO
RESTORE SCREEN
ENDCASE
ENDDO
RETURN